home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 2856.ZIP / KEYTREE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-05-11  |  53KB  |  1,720 lines
  1. unit KeyTree;
  2. {$M 4096,0,655360}
  3. { FEBRUARY 1991 version 3
  4.  
  5. *****************************************************************************
  6. *                                        *
  7. *    KeyTree Toolbox                                *
  8. *                                        *
  9. *    Copyright 1991 by Rewse Consultants Limited                *
  10. *                                        *
  11. *  The KeyTree Toolbox is issued as shareware. In case you are unaware of   *
  12. *  how the shareware system works, it is NOT 'free' software.            *
  13. *  No initial charge is made for the software, so that you can try it out   *
  14. *  without obligation. However, if you continue to use the software (and in *
  15. *  the case of the KeyTree Toolbox, use programs created using it),        *
  16. *  then you are required to pay a registration fee. To register your use of *
  17. *  the KeyTree Toolbox, we ask you to pay a miserly £30 (UK Pounds), a mere *
  18. *  fraction of the cost that you are saving in time and effort. Please send *
  19. *  your registration fee to :                            *
  20. *                                        *
  21. *    Rewse Consultants Limited                        *
  22. *    44, Horseshoe Road, Pangbourne, Reading, Berkshire RG8 7JL, UK      *
  23. ****************************************************************************}
  24.  
  25. interface
  26. uses crt,dos;
  27.  
  28. type    arrayn = array[0..1] of integer;
  29.     arrayp = ^arrayn;
  30.     Chars  = array[0..1] of char;
  31.     charp  = ^Chars;
  32.  
  33. const   ktRUNCH : char = #0;
  34.     ktRUNSC : integer = 0;
  35. var     ktSCAN,ktERRNO,ktFKEY : integer;
  36.     ktCHAR  : char;
  37.     ktINDEXED : Boolean;
  38.  
  39. function   ktCreate(name : string; chain, indexct : integer; var keys )
  40.                                 : Boolean;
  41. function   ktOpen(name : string; mode, indexno : integer)    : integer;
  42. function   ktChangeIndex(f, indexno : integer)            : Boolean;
  43. function   ktFlush(f : integer)                    : Boolean;
  44. function   ktClose(f : integer)                    : Boolean;
  45. function   ktAdd(f : integer; var data; size : integer)        : Boolean;
  46. function   ktAddPhys(f : integer; var data; size : integer)    : Boolean;
  47. function   ktRead(f : integer; var data; key : string)        : integer;
  48. function   ktReadAfter(f : integer; var data; key : string)    : integer;
  49. function   ktReadBefore(f : integer; var data; key : string)    : integer;
  50. function   ktLength(f : integer; key : string)            : integer;
  51. function   ktNext(f : integer; var data)            : integer;
  52. function   ktPrev(f : integer; var data)            : integer;
  53. function   ktNextPhys(f : integer; var data)            : integer;
  54. function   ktPrevPhys(f : integer; var data)            : integer;
  55. function   ktDelete(f : integer; var data)            : Boolean;
  56. function   ktUndelete(f : integer; var data)            : Boolean;
  57. function   ktRewrite(f : integer; var data; size : integer)    : Boolean;
  58. procedure  ktGetChar;
  59. procedure  ktGetPress;
  60. function   ktGetStr(var data; maxlen : integer)            : integer;
  61. function   ktGetKey(f : integer; var data,key)            : integer;
  62. function   ktReadAll(f : integer; var data; key : string)    : integer;
  63. function   ktNextAll(f : integer; var data)            : integer;
  64. function   ktPrevAll(f : integer; var data)            : integer;
  65. function   ktAddChain(f : integer; var data; size : integer)    : Boolean;
  66. function   ktNextChain(f : integer; var data)            : integer;
  67. function   ktPrevChain(f : integer; var data)            : integer;
  68. function   ktStart(f : integer; var data)            : integer;
  69. function   ktEnd(f : integer; var data)                : integer;
  70. function   ktStartPhys(f : integer; var data)            : integer;
  71. function   ktEndPhys(f : integer; var data)            : integer;
  72. function   ktLock(f : integer)                    : Boolean;
  73. function   ktUnlock(f : integer)                : Boolean;
  74. function   ktLocked(f : integer; key : string)            : Boolean;
  75. function   ktSize(f : integer)                    : longint;
  76. function   ktRecords(f,typ : integer)                : longint;
  77. function   ktMaxRead(f,max : integer)                : integer;
  78. procedure  KtBuildKey(f : integer; var d ;f1,f2 : string);
  79.  
  80. implementation
  81.  
  82. uses funckey;
  83.  
  84. type
  85.         Bytes  = array[0..MaxInt] of byte;
  86.     kt_rec = record  dup,inxct,curinx,inx_entry,access,ksz    : integer;
  87.                fd                    : file;
  88.                curtyp,maxkey,ixdes,ixlen,kt,minsiz,hks    : integer;
  89.                chain : array[0..1] of longint;
  90.                inx_pos,base,recptr,nexrec,fsize        : longint;
  91.                BaseEntry,start                : longint;
  92.                status                    : byte;
  93.                filename                    : string[15];
  94.                keys                    : arrayp;
  95.                del,maxread                : integer;
  96.         end;
  97.     bb_ptr = ^Bytes;
  98.     strptr = ^string;
  99.     kt_ptr = ^kt_rec;
  100.     kt_ptr_ptr = array[0..1] of kt_ptr;
  101.         kt_list = ^kt_ptr_ptr;
  102.     ix_dets = record ix   : longint;
  103.              en,x : integer;
  104.           end;
  105.  
  106. const    kt_inx_size    : array[0..3] of integer = (30,13,40,99);
  107.     kt_filect    : integer = 0;
  108.     kt_function    : Boolean = False;
  109.     ext_fil        : string[5] = '.fil';
  110.     my_list        : kt_list = nil;
  111.     cur_ind_ind    : integer = 1000;
  112.     cur_ind_fd    : integer = 1000;
  113.     cur_ind_pos    : longint = 1000;
  114.  
  115. var    KT        : kt_ptr;
  116.     kt_alter    : array[0..10] of ix_dets;
  117.         kt_tmplen    : array[0..1] of integer;
  118.     kt_inx_char    : longint;
  119.     kt_inx        : array[0..99] of longint;
  120.     kt_FORWARD,ktCT    : integer;
  121.     old_length    : array[0..1] of integer;
  122.     oldix        : array[0..10] of ix_dets;
  123.     record_moved    : Boolean;
  124.     kt_found    : Boolean;
  125.     my_k,my_x,my_y    : integer;
  126.     oldk,newk    : pointer;
  127.  
  128. {$I-}
  129.  
  130. procedure kt_wrt_data(var ptr ; len : integer);
  131. var b : integer;
  132. begin    BlockWrite(KT^.fd,Chars(ptr),word(len));
  133.     b := IOresult;
  134. end;
  135. procedure kt_read_data(var ptr ; len : integer);
  136. var b : integer;
  137. begin    BlockRead(KT^.fd,Chars(ptr),len);
  138.     b := IOresult;
  139. end;
  140.  
  141. procedure kt_seek(offs : longint);
  142. var b : integer;
  143. begin    seek(KT^.fd,offs);
  144.     b := IOresult;
  145. end;
  146.  
  147. procedure kt_wrt_status;
  148. begin    kt_seek(KT^.recptr);
  149.     kt_wrt_data(KT^.status,1);
  150. end;
  151.  
  152. procedure kt_wrt_elem(var recpt; y : integer);
  153.  
  154. var x : integer;
  155.  
  156. begin    kt_wrt_status;
  157.     x := 0;
  158.     if (KT^.dup <> 0) then kt_wrt_data(KT^.chain[0],KT^.dup);
  159.     kt_wrt_data(y,2);
  160.     kt_wrt_data(x,2);
  161.     kt_wrt_data(recpt,y);
  162.     x := y + KT^.dup + 7;
  163.     kt_wrt_data(x,2);
  164.     Inc(KT^.fsize,x);
  165. end;
  166. function kt_FileOpen(fno : integer) : Boolean;
  167. begin   if (fno > 0) then
  168.     begin    Dec(fno);
  169.         if (fno < kt_filect) then
  170.         begin    KT := my_list^[fno];
  171.             if (KT <> nil) then
  172.             begin    ktERRNO := 0;
  173.                 kt_FileOpen := True;
  174.                 exit;
  175.             end;
  176.         end;
  177.     end;
  178.     ktERRNO := 9;
  179.     kt_FileOpen := False;
  180. end;
  181.  
  182. function kt_FileReady(fno : integer) : Boolean;
  183. var x : integer;
  184. begin   kt_FileReady := True;
  185.     if kt_FileOpen(fno) then
  186.     begin    x := KT^.status and $80;
  187.         if x <> 0 then ktERRNO := 28
  188.         else    begin    if (KT^.recptr > 0) then exit;
  189.                 ktERRNO := 20;
  190.             end;
  191.     end;
  192.     kt_FileReady := False;
  193. end;
  194.  
  195. function kt_OKtowrite : Boolean;
  196. begin    kt_OKtowrite := True;
  197.     if (KT^.access <> 0)    then exit;
  198.     ktERRNO := 12;
  199.     kt_OKtowrite := False;
  200. end;
  201.  
  202. function kt_locked(fno : integer) : Boolean;
  203. var    x : integer;
  204. begin   kt_locked := True;
  205.     if not kt_FileReady(fno) then exit;
  206.     if not kt_OKtowrite then exit;
  207.     x := KT^.status and 1;
  208.     if x <> 0 then    begin    ktERRNO := 22;
  209.                 exit;
  210.             end;
  211.     kt_locked := False;
  212. end;
  213.  
  214. function kt_inx_key(keychar : char) : integer;
  215. var    z : byte; x : char;
  216. begin    x := keychar;
  217.     z := Ord(x);
  218.     if z <> 0 then case KT^.curtyp of
  219.  
  220.     0 :    begin if (x = ' ') then z := 2
  221.               else begin if (x >= 'a') and (x <= 'z') then Dec(z,94)
  222.                  else begin if (x >= 'A') and (x <= 'Z')
  223.                                   then Dec(z,62)
  224.                         else z := 1;
  225.                       end;
  226.                end;
  227.         end;
  228.     1 :    begin    if (z < 47) or (z > 57) then z := 1
  229.             else Dec(z,46);
  230.         end;
  231.     2 :    begin    if (x = ' ')                then z := 2
  232.             else begin if (x >= 'a') and (x <= 'z')    then Dec(z,84)
  233.                    else begin
  234.                    if (x >= 'A') and (x <= 'Z') then Dec(z,52)
  235.                    else begin                 Dec(z,45);
  236.                    if (z < 3) or (z > 12)    then z := 1;
  237.                     end;
  238.                    end;
  239.             end;
  240.         end;
  241.     3 :    begin    if (z < 31) or (z > 127) then z := 1
  242.             else Dec(z,30);
  243.         end;
  244.     end;
  245.     KT^.inx_entry := z + 1;
  246.     kt_inx_key := z + 1;
  247. end;
  248.  
  249. procedure kt_setupkey(var key, recpt);
  250. var    x,y,z,L,S,b,c : integer;
  251.  
  252. begin    for x := 1 to KT^.maxkey do Chars(key)[x] := #0;
  253.     y := KT^.ixdes;
  254.     z := 1;
  255.     c := KT^.keys^[3*(KT^.curinx) + 2];
  256.     for x :=  1 to c
  257.         do begin L := KT^.keys^[y];
  258.              Inc(y);
  259.              S := KT^.keys^[y];
  260.              Inc(y);
  261.              while (Bytes(recpt)[s] <> 0) and (L > 0) do
  262.                 begin    Chars(key)[z] := Chars(recpt)[S];
  263.                     Inc(z);
  264.                     Inc(S);
  265.                     Dec(L);
  266.                 end;
  267.              if (x < c) and (L > 0) then Inc(z);
  268.            end;
  269.     Bytes(key)[0] := z - 1;
  270. end;
  271. procedure kt_readkey(var ptr);
  272. var trec : charp; x : word;
  273. begin
  274.     kt_seek(kt_inx_char);
  275.     kt_read_data(KT^.status,1);
  276.     if (KT^.dup <> 0) then kt_seek(kt_inx_char + KT^.dup + 1);
  277.     kt_read_data(kt_tmplen[0],2);
  278.     kt_read_data(x,2);
  279.     if kt_tmplen[0] > KT^.maxkey then x := kt_tmplen[0]
  280.     else                  x := KT^.maxkey + 1;
  281.     GetMem(trec,x);
  282.     if (trec = nil) then ktERRNO := 7
  283.     else begin FillChar(trec^,x,#0);
  284.            kt_read_data(trec^,kt_tmplen[0]);
  285.            kt_setupkey(ptr,trec^);
  286.            FreeMem(trec,x);
  287.          end;
  288. end;
  289. procedure kt_setname(var ptr1,ptr2);
  290. var x,y : integer;
  291. begin
  292.     x := 1;
  293.     y := Bytes(ptr1)[0];
  294.     move(Bytes(ptr1)[0], Bytes(ptr2)[0], y + 1);
  295.     while (x <= y) and (Chars(ptr1)[x] <> '.') do Inc(x);
  296.     if (x > y) then
  297.         begin    Move(ext_fil[1],Bytes(ptr2)[x],4);
  298.             Bytes(ptr2)[0] := x + 3;
  299.         end;
  300. end;
  301. function kt_read_elem(var recpt) : integer;
  302. var    x,a : integer;
  303. begin
  304.     kt_read_elem := 0;
  305.     ktINDEXED :=  ((KT^.status and 2) = 0);
  306.     if (KT^.dup <> 0) then kt_read_data(KT^.chain[0],KT^.dup);
  307.     kt_read_data(x,2);
  308.     kt_read_data(a,2);
  309.     if (x > 0) then
  310.            begin KT^.nexrec := KT^.recptr + x + a + KT^.dup + 7;
  311.              kt_read_elem := x;
  312.              if (KT^.maxread > 0) and (x > KT^.maxread) then
  313.                 x := KT^.maxread;
  314.              kt_read_data(recpt,x);
  315.            end
  316.     else ktERRNO := 18;
  317. end;
  318.  
  319. function kt_read_indexed(var recpt) : integer;
  320. begin    kt_seek(KT^.recptr);
  321.     kt_read_data(KT^.status,1);
  322.     kt_read_indexed := kt_read_elem(recpt);
  323. end;
  324.  
  325. procedure kt_next_index(y : integer);
  326. var    x,z : integer;
  327. begin
  328.     KT^.curinx := y;
  329.     KT^.curtyp := KT^.keys^[3*y + 1];
  330.     KT^.maxkey := 0;
  331.     z := 3*KT^.inxct;
  332.     if y > 0 then for x := 0 to y - 1 do Inc(z,2*KT^.keys^[3*x + 2]);
  333.     KT^.ixdes := z;
  334.     for x := 1 to KT^.keys^[3*y + 2] do
  335.     begin    Inc(KT^.maxkey,KT^.keys^[z]);
  336.         Inc(z,2);
  337.     end;
  338. end;
  339.  
  340. procedure kt_read_index;
  341. begin
  342.       if (KT^.kt <> cur_ind_fd) or (KT^.inx_pos <> cur_ind_pos) or
  343.          (cur_ind_ind <> KT^.curinx) then
  344.       begin kt_seek(-KT^.inx_pos + 1);
  345.         kt_read_data(kt_inx,kt_inx_size[KT^.curtyp]*SizeOf(longint));
  346.         cur_ind_ind := KT^.curinx;
  347.         cur_ind_fd  := KT^.kt;
  348.         cur_ind_pos := KT^.inx_pos;
  349.       end;
  350. end;
  351.  
  352. procedure kt_wrt_index;
  353. var      b : integer; a : array[0..1] of byte;
  354. begin
  355.       kt_seek(-KT^.inx_pos);
  356.       a[0] := byte('0') + KT^.curinx;
  357.       kt_wrt_data(a,1);
  358.       b := kt_inx_size[KT^.curtyp]*SizeOf(longint);
  359.       kt_wrt_data(kt_inx,b);
  360.       if KT^.fsize = -KT^.inx_pos then begin Inc(b,3);
  361.                          kt_wrt_data(b,2);
  362.                          Inc(KT^.fsize,b);
  363.                        end;
  364.       cur_ind_ind := KT^.curinx;
  365.       cur_ind_fd  := KT^.kt;
  366.       cur_ind_pos := KT^.inx_pos;
  367. end;
  368.  
  369. procedure kt_zero_index(k : integer);
  370. var    L,Q   : longint; x,y,b : integer;
  371. begin
  372.     kt_inx[KT^.inx_entry] := 0;
  373.     if kt_inx[0] <> 0 then
  374.     begin y := 0;
  375.           b := 0;
  376.           Q := 0;
  377.           for x := 1 to kt_inx_size[KT^.curtyp] - 1 do
  378.           begin if kt_inx[x] <> 0 then
  379.             begin Inc(y);
  380.               if y > 1 then x := kt_inx_size[KT^.curtyp] - 1
  381.               else  begin Q := kt_inx[x];
  382.                       if x < KT^.inx_entry then b := 1
  383.                       else            b := 2;
  384.                 end;
  385.             end;
  386.           end;
  387.           if (y < 2) and (Q >= 0) then
  388.           begin while (y < 2) and (kt_inx[0] <> 0) do
  389.             begin L := KT^.inx_pos;
  390.               KT^.inx_pos := kt_inx[0];
  391.               kt_read_index;
  392.               KT^.inx_entry := 1;
  393.               while (L <> kt_inx[KT^.inx_entry]) do
  394.                     Inc(KT^.inx_entry);
  395.               if (KT^.BaseEntry <> 0) and (L = KT^.base) then
  396.               begin KT^.base := KT^.inx_pos;
  397.                 KT^.BaseEntry := KT^.inx_entry;
  398.               end;
  399.               kt_inx[KT^.inx_entry] := Q;
  400.               y := 0;
  401.               for x := 1 to kt_inx_size[KT^.curtyp] - 1 do
  402.               begin if kt_inx[x] <> 0 then Inc(y);
  403.                 if y > 1 then x := kt_inx_size[KT^.curtyp] - 1
  404.               end;
  405.             end;
  406.             if k = KT^.curinx then KT^.del := b;
  407.           end;
  408.     end;
  409.     kt_wrt_index;
  410. end;
  411.  
  412. procedure set_values(x,z : integer);
  413. begin
  414.     kt_alter[KT^.curinx].ix := KT^.inx_pos;
  415.     kt_alter[KT^.curinx].x  := x;
  416.     kt_alter[KT^.curinx].en := z;
  417. end;
  418.  
  419. function kt_lookup(var key) : Boolean;
  420. var     x,y,z,k : integer;
  421. begin
  422.      KT^.inx_pos := -KT^.keys^[3*KT^.curinx];
  423.      y := KT^.maxkey;
  424.      if y > Bytes(key)[0] then y := Bytes(key)[0];
  425.      kt_lookup := False;
  426.      for x := 1 to y + 1 do
  427.         begin kt_read_index;
  428.               if x = y + 1 then z := kt_inx_key(#0)
  429.               else z := kt_inx_key(Chars(key)[x]);
  430.               if kt_inx[z] = 0 then begin set_values(x,z);
  431.                           exit;
  432.                         end;
  433.               kt_inx_char := kt_inx[z];
  434.               if kt_inx_char > 0 then begin KT^.recptr := kt_inx_char;
  435.                             kt_lookup := True;
  436.                             set_values(x,z);
  437.                             exit;
  438.                           end;
  439.               KT^.inx_pos := kt_inx_char;
  440.         end;
  441. end;
  442.  
  443. procedure kt_record_lookup(var recpt);
  444. var temk : pointer; x : Boolean; f : integer;
  445. begin      f := KT^.maxkey+1;
  446.       GetMem(temk,f);
  447.       if (temk <> nil) then begin kt_setupkey(temk^,recpt);
  448.                       x := kt_lookup(temk^);
  449.                       FreeMem(temk,f);
  450.                 end;
  451. end;
  452.  
  453. function kt_keysmatch(var new,old) : integer;
  454. var     x,y,z,f,q : integer; a,b     : char;
  455. begin
  456.     kt_keysmatch := 0;
  457.     f := 0;
  458.     if Ord(chars(new)[0]) > KT^.maxkey then q := KT^.maxkey
  459.     else                    q := Ord(chars(new)[0]);
  460.     for x := 1 to q do
  461.         begin if f >= Ord(chars(old)[0]) then
  462.                       begin kt_keysmatch := 1;
  463.                             exit;
  464.                       end;
  465.                       Inc(f);
  466.                       a := Chars(new)[x];
  467.               b := Chars(old)[x];
  468.               if a <> b    then begin z := KT^.inx_entry;
  469.                        y := kt_inx_key(a) - kt_inx_key(b);
  470.                        KT^.inx_entry := z;
  471.                        if y <> 0 then
  472.                         begin kt_keysmatch := y;
  473.                               exit;
  474.                         end;
  475.                      end;
  476.         end;
  477.         if f < Ord(chars(old)[0]) then kt_keysmatch := -1;
  478. end;
  479.  
  480. function kt_exists(var key) : integer;
  481. var     z,f : integer; temk : charp; s : string;
  482. begin
  483.      if kt_lookup(key) then
  484.      begin f := KT^.maxkey+1;
  485.            GetMem(temk,f);
  486.            if (temk <> nil) then
  487.            begin
  488.                      kt_readkey(temk^);
  489.              z := kt_keysmatch(chars(key),temk^);
  490.              FreeMem(temk,f);
  491.              if z = 0 then begin kt_exists := kt_tmplen[0];
  492.                      exit;
  493.                    end;
  494.            end;
  495.      end;
  496.      kt_exists := 0;
  497. end;
  498.  
  499. procedure compare_chars;
  500. var      i : integer; q : longint;
  501. begin q := -KT^.fsize;
  502.       while True do begin my_k := kt_inx_key(Chars(oldk^)[my_y]);
  503.               my_x := kt_inx_key(Chars(newk^)[my_y]);
  504.               if my_k <> my_x then exit;
  505.               kt_inx[my_k] := q;
  506.               kt_wrt_index;
  507.               kt_inx[0] := KT^.inx_pos;
  508.               KT^.inx_pos := q;
  509.               Dec(q,kt_inx_size[KT^.curtyp]*SizeOf(longint) + 3);
  510.               for i := 1 to kt_inx_size[KT^.curtyp] do
  511.                            kt_inx[i] := 0;
  512.               Inc(my_y);
  513.            end;
  514. end;
  515. procedure kt_update_index(var recpt; s : integer);
  516. var      L : longint; f : integer;
  517. begin
  518.       L := KT^.recptr;
  519.       if s <> 0 then KT^.inx_pos := -KT^.keys^[3*KT^.curinx]
  520.       else KT^.inx_pos := kt_alter[KT^.curinx].ix;
  521.       f := KT^.maxkey+1;
  522.       GetMem(newk,f);
  523.       if newk = nil then begin ktERRNO := 7;
  524.                    exit;
  525.                  end;
  526.       FillChar(newk^,f,#0);
  527.       kt_setupkey(newk^,recpt);
  528.       kt_read_index;
  529.       if s <> 0 then
  530.       begin my_y := 1;
  531.         kt_inx_char := -1;
  532.         while kt_inx_char < 0 do
  533.         begin my_x := kt_inx_key(Chars(newk^)[my_y]);
  534.               kt_inx_char := kt_inx[my_x];
  535.               if kt_inx_char < 0 then
  536.               begin KT^.inx_pos := kt_inx_char;
  537.                 kt_read_index;
  538.                 Inc(my_y);
  539.               end;
  540.         end;
  541.       end
  542.       else  begin my_x := kt_alter[KT^.curinx].en;
  543.               my_y := kt_alter[KT^.curinx].x;
  544.         end;
  545.       kt_inx_char := kt_inx[my_x];
  546.       if kt_inx_char <> 0 then begin GetMem(oldk,f);
  547.                      if (oldk <> nil) then
  548.                      begin kt_readkey(oldk^);
  549.                            compare_chars;
  550.                            kt_inx[my_k] := kt_inx_char;
  551.                            FreeMem(oldk,f);
  552.                      end;
  553.                    end;
  554.       KT^.recptr := L;
  555.       kt_inx[my_x] := KT^.recptr;
  556.       KT^.inx_entry := my_x;
  557.       kt_wrt_index;
  558.       FreeMem(newk,f);
  559. end;
  560. function kt_OKtoadd(var recpt; err : integer) : Boolean;
  561. var     y,z,k,j,f : integer; L : longint; keypt : charp; s : string;
  562.      c       : char;
  563. begin
  564.      kt_OKtoadd := False;
  565.      k := KT^.curinx;
  566.      L := KT^.recptr;
  567.      for y := 0 to KT^.inxct - 1 do
  568.         begin kt_alter[y].ix := 0;
  569.               kt_next_index(y);
  570.               f := KT^.maxkey+1;
  571.               GetMem(keypt,f);
  572.                   if keypt = nil then begin ktERRNO := 7;
  573.                                                 exit;
  574.                       end;
  575.               FillChar(keypt^,f,#0);
  576.               kt_setupkey(keypt^,recpt);
  577.               j := kt_exists(keypt^);
  578.               FreeMem(keypt,f);
  579.               if j <> 0 then    begin ktERRNO := y + err;
  580.                           kt_next_index(k);
  581.                           KT^.recptr := L;
  582.                           exit;
  583.                                         end;
  584.         end;
  585.      kt_next_index(k);
  586.      KT^.recptr := L;
  587.      kt_OKtoadd := True;
  588. end;
  589.  
  590. function   ktCreate(name : string; chain, indexct : integer; var keys) : Boolean;
  591. var     x,y,z,k,n,f,b : integer; zz : array[0..1] of char; t : kt_rec;
  592. begin
  593.      ktERRNO := 13;
  594.          ktCreate := False;
  595.      if (chain <> 0) then chain := 2*SizeOf(longint);
  596.      if (indexct > 10) or (indexct <= 0) then exit;
  597.          k := 0;
  598.          y := 0;
  599.      for x := 1 to indexct do
  600.         begin if (arrayn(keys)[y] < 0) or
  601.                          (arrayn(keys)[y] > 3) then exit;
  602.               if (arrayn(keys)[y + 1] < 1) then exit;
  603.               Inc(y);
  604.               while arrayn(keys)[y] >= 0 do
  605.                 begin Inc(k,2);
  606.                   if arrayn(keys)[y] < 1 then exit;
  607.                   Inc(y);
  608.                   if arrayn(keys)[y] < 0 then exit;
  609.                                   Inc(y);
  610.                 end;
  611.               Inc(y);
  612.         end;
  613.     kt_setname(name,t.filename);
  614.         Assign(t.fd,t.filename);
  615.         Reset(t.fd,1);
  616.     if IOresult = 0 then begin Close(t.fd);
  617.                                    ktERRNO := 1;
  618.                                    exit;
  619.                              end;
  620.     Rewrite(t.fd,1);
  621.     ktERRNO := 2;
  622.     if IOresult <> 0 then exit;
  623.     t.inxct := indexct;
  624.     t.dup   := 19284;
  625.     if chain <> 0 then Inc(t.dup);
  626.     t.curinx := 2*(k + 3*indexct);
  627.     BlockWrite(t.fd,t.dup,6);
  628.     if IOresult <> 0 then begin Close(t.fd);
  629.                     exit;
  630.                   end;
  631.     f := t.curinx;
  632.     GetMem(t.keys,f);
  633.     if t.keys = nil then begin ktERRNO := 7;
  634.                                    Close(t.fd);
  635.                                    exit;
  636.                              end;
  637.     n := t.curinx + 6;
  638.     z := 3*indexct;
  639.         y := 0;
  640.     for x := 0 to 3*indexct - 1 do
  641.         begin t.keys^[x] := n;
  642.                       Inc(x);
  643.               Inc(n, kt_inx_size[arrayn(keys)[y]]*SizeOf(longint) + 3);
  644.               t.keys^[x] := arrayn(keys)[y];
  645.                       Inc(x);
  646.                       Inc(y);
  647.               t.keys^[x] := 0;
  648.                       while arrayn(keys)[y] >= 0 do
  649.             begin  Inc(t.keys^[x]);
  650.                    t.keys^[z] := arrayn(keys)[y];
  651.                                Inc(z);
  652.                                Inc(y);
  653.                    t.keys^[z] := arrayn(keys)[y];
  654.                                Inc(z);
  655.                                Inc(y);
  656.             end;
  657.               Inc(y);
  658.         end;
  659.     BlockWrite(t.fd,t.keys^,t.curinx);
  660.     if IOresult <> 0 then begin Close(t.fd);
  661.                     FreeMem(t.keys,f);
  662.                     exit;
  663.                   end;
  664.     for x := 0 to 98 do kt_inx[x] := 0;
  665.     for x := 0 to indexct - 1 do
  666.         begin zz[0] := char(byte('0') + x);
  667.               BlockWrite(t.fd,zz,1);
  668.               if IOresult <> 0 then begin Close(t.fd);
  669.                           FreeMem(t.keys,f);
  670.                           exit;
  671.                         end;
  672.               b := kt_inx_size[t.keys^[3*x + 1]]*SizeOf(longint);
  673.               BlockWrite(t.fd,kt_inx,b);
  674.               if IOresult <> 0 then begin Close(t.fd);
  675.                           FreeMem(t.keys,f);
  676.                           exit;
  677.                         end;
  678.               Inc(b,3);
  679.               BlockWrite(t.fd,b,2);
  680.               if IOresult <> 0 then begin Close(t.fd);
  681.                           FreeMem(t.keys,f);
  682.                           exit;
  683.                         end;
  684.         end;
  685.     Close(t.fd);
  686.     FreeMem(t.keys,f);
  687.     ktERRNO := 0;
  688.     ktCreate := True;
  689. end;
  690. procedure set_min_size;
  691. var x,y,z,q,a : integer;
  692. begin   z := 3*KT^.inxct;
  693.     KT^.minsiz := 1;
  694.     KT^.hks := 1;
  695.     for x := 0 to KT^.inxct - 1 do
  696.     begin y := KT^.keys^[3*x + 2];
  697.           for a := 1 to y do
  698.           begin q := KT^.keys^[z] + KT^.keys^[z+1];
  699.             if KT^.minsiz < q then KT^.minsiz := q;
  700.             if KT^.keys^[z+1] > KT^.hks - 1 then
  701.                KT^.hks := KT^.keys^[z+1] + 1;
  702.             Inc(z,2);
  703.           end;
  704.     end;
  705. end;
  706.  
  707. function   ktOpen(name : string; mode, indexno : integer) : integer;
  708. var     x,y : integer; t : kt_ptr; tt : kt_list; bb : bb_ptr; c : char;
  709. begin
  710.     ktOpen := 0;
  711.     if (indexno < 0) then begin ktERRNO := 4;
  712.                     exit;
  713.                   end;
  714.     ktERRNO := 0;
  715.         y := 0;
  716.         tt := my_list;
  717.         if kt_filect > 0 then
  718.     begin while (y < kt_filect) and (my_list^[y] <> nil) do Inc(y);
  719.           if y = kt_filect then
  720.           begin Inc(kt_filect);
  721.                     GetMem(tt,kt_filect*SizeOf(kt_ptr));
  722.                 if tt = nil then begin ktERRNO := 7;
  723.                                            exit;
  724.                                      end;
  725.             for x := 0 to y - 1 do tt^[x] := my_list^[x];
  726.             FreeMem(my_list,y*SizeOf(kt_ptr));
  727.             my_list := tt;
  728.           end;
  729.         end
  730.         else  begin GetMem(my_list,SizeOf(kt_ptr));
  731.                     if my_list = nil then begin ktERRNO := 7;
  732.                                                 exit;
  733.                                           end;
  734.                     kt_filect := 1;
  735.               end;
  736.     GetMem(my_list^[y],SizeOf(kt_rec));
  737.     KT := my_list^[y];
  738.     if KT = nil then begin ktERRNO := 7;
  739.                                exit;
  740.                          end;
  741.     KT^.kt := y;
  742.     kt_setname(name,KT^.filename);
  743.         Assign(KT^.fd,KT^.filename);
  744.         Reset(KT^.fd,1);
  745.     if IOresult <> 0 then begin ktERRNO := 2;
  746.                     FreeMem(my_list^[y],SizeOf(kt_rec));
  747.                     my_list^[y] := nil;
  748.                     exit;
  749.                   end
  750.     else begin
  751.              KT^.maxread := 0;
  752.              KT^.fsize := FileSize(KT^.fd);
  753.              if KT^.fsize <= 0 then ktERRNO := 6
  754.          else begin
  755.                   kt_seek(0);
  756.           kt_read_data(KT^,6);
  757.           x := KT^.dup - 19284;
  758.           if (x <> 0) and (x <> 1) and (x <> $100) and (x <> $101)
  759.                                  then ktERRNO := 3
  760.           else begin
  761.                        KT^.dup := x and 1;
  762.               if KT^.dup <> 0 then KT^.dup := 2*SizeOf(longint);
  763.               if KT^.inxct <= indexno then ktERRNO := 4
  764.               else begin
  765.                GetMem(KT^.keys,KT^.curinx);
  766.                if KT^.keys = nil then ktERRNO := 7
  767.                else begin    KT^.ksz := KT^.curinx;
  768.                     kt_read_data(KT^.keys^,KT^.curinx);
  769.                     kt_next_index(indexno);
  770.                     KT^.access := mode;
  771.                     KT^.inx_entry := 0;
  772.                     KT^.recptr := 0;
  773.                     KT^.BaseEntry := 0;
  774.                     KT^.start :=
  775.                     kt_inx_size[KT^.keys^[3*(KT^.inxct-1) + 1]]*SizeOf(longint) +
  776.                     KT^.keys^[3*KT^.inxct - 3] + 3;
  777.                     set_min_size;
  778.                     ktOpen := y + 1;
  779.                     exit;
  780.                 end;
  781.                end;
  782.                       end;
  783.                   end;
  784.        Close(KT^.fd);
  785.      end;
  786.     FreeMem(my_list^[y],SizeOf(kt_rec));
  787.     my_list^[y] := nil;
  788. end;
  789.  
  790. function ktChangeIndex(f, indexno : integer) : Boolean;
  791.  
  792. begin   ktChangeIndex := False;
  793.     if not kt_FileOpen(f) then exit;
  794.     if (indexno < 0) or (indexno >= KT^.inxct) then begin ktERRNO := 4;
  795.                                                               exit;
  796.                                                         end;
  797.     if indexno <> KT^.curinx then
  798.         begin kt_next_index(indexno);
  799.               KT^.BaseEntry := 0;
  800.                       KT^.inx_entry := 0;
  801.               KT^.inx_pos   := -KT^.keys^[3*KT^.curinx];
  802.         end;
  803.     ktChangeIndex := True;
  804. end;
  805. function ktFlush(f : integer) : Boolean;
  806.  
  807. begin   ktFlush := False;
  808.     if not kt_FileOpen(f) then exit;
  809.     Close(KT^.fd);
  810.         Assign(KT^.fd,KT^.filename);
  811.     Reset(KT^.fd,1);
  812.     ktFlush := True;
  813. end;
  814.  
  815. function ktClose(f : integer) : Boolean;
  816.  
  817. var y : integer;
  818. begin   if not kt_FileOpen(f) then ktClose := False
  819.     else begin Close(KT^.fd);
  820.            cur_ind_fd := 1000;
  821.            FreeMem(KT^.keys,KT^.ksz);
  822.            FreeMem(my_list^[f-1],SizeOf(kt_rec));
  823.            my_list^[f-1] := nil;
  824.            ktClose := True;
  825.          end;
  826. end;
  827. procedure add_indexes(var recpt);
  828. var      k,y : integer;
  829.  
  830. begin
  831.       k := KT^.curinx;
  832.       for y := 0 to KT^.inxct-1 do
  833.         if y <> k then    begin kt_next_index(y);
  834.                       kt_update_index(recpt,0);
  835.                 end;
  836.       kt_next_index(k);
  837.       kt_update_index(recpt,0);
  838. end;
  839.  
  840. function   ktAdd(f : integer; var data; size : integer) : Boolean;
  841. var       areapt : charp; x,y : integer;
  842. begin      ktAdd := True;
  843.        if size < 1 then ktERRNO := 15
  844.        else if kt_FileOpen(f) then
  845.         begin if kt_OKtowrite then
  846.               begin
  847.                 if size < KT^.minsiz then
  848.                 begin GetMem(areapt,KT^.minsiz);
  849.                   FillChar(areapt^,KT^.minsiz,#0);
  850.                   Move(Chars(data),areapt^,size);
  851.                   if size > KT^.hks then x := size
  852.                   else               x := KT^.hks;
  853.                   if areapt^[x-1] <> #0 then Inc(x);
  854.                 end
  855.                 else  areapt := nil;
  856.                 if kt_OKtoadd(data,40) then
  857.                 begin
  858.                   KT^.recptr   := KT^.fsize;
  859.                   KT^.chain[0] := 0;
  860.                                   KT^.chain[1] := 0;
  861.                   KT^.status   := 0;
  862.                   if areapt <> nil then
  863.                   begin kt_wrt_elem(areapt^,x);
  864.                         add_indexes(areapt^);
  865.                     FreeMem(areapt,KT^.minsiz);
  866.                                   end
  867.                   else
  868.                   begin kt_wrt_elem(data,size);
  869.                     add_indexes(data);
  870.                   end;
  871.                   exit;
  872.                             end
  873.                             else if areapt <> nil then
  874.                     FreeMem(areapt,KT^.minsiz);
  875.                 KT^.recptr := 0;
  876.                       end;
  877.         end;
  878.            ktAdd := False;
  879. end;
  880. function ktAddPhys(f : integer; var data; size : integer) : Boolean;
  881.  
  882. begin    if size < 1 then ktERRNO := 15
  883.     else    if kt_FileOpen(f) then
  884.             if kt_OKtowrite then
  885.                 begin KT^.chain[0] := 0;
  886.                                       KT^.chain[1] := 0;
  887.                       KT^.recptr   := KT^.fsize;
  888.                       KT^.status   := 2;
  889.                       kt_wrt_elem(data,size);
  890.                                       ktAddPhys := True;
  891.                       exit;
  892.                 end;
  893.     ktAddPhys := False;
  894. end;
  895. function NN_NN(var recpt; b, errs : integer) : integer;
  896.  
  897. var    a1   : integer;    y,z,a2,comp,c2 : longint; q : Boolean;
  898. begin
  899.     a1 := KT^.inx_entry;
  900.     a2 := KT^.inx_pos;
  901.     KT^.del := 0;
  902.     kt_read_index;
  903.         if (b <> 0) then comp := -KT^.keys^[3*KT^.curinx]
  904.         else             comp := KT^.base;
  905.     while True do
  906.     begin if kt_FORWARD <= 0 then begin Dec(KT^.inx_entry);
  907.                         q := (KT^.inx_entry <= 0) or
  908.                   ((b = 0) and (KT^.inx_pos = KT^.base) and
  909.                    (KT^.inx_entry <> KT^.BaseEntry));
  910.                       end
  911.           else begin Inc(KT^.inx_entry);
  912.              q := (KT^.inx_entry >= kt_inx_size[KT^.curtyp]) or
  913.                   ((b = 0) and (KT^.inx_pos = KT^.base) and
  914.                    (KT^.inx_entry <> KT^.BaseEntry));
  915.                    end;
  916.           if q then begin if KT^.inx_pos >= comp then
  917.                   begin ktERRNO := errs;
  918.                     KT^.inx_entry := a1;
  919.                                     KT^.inx_pos   := a2;
  920.                                     NN_NN := 0;
  921.                                     exit;
  922.                               end;
  923.                   y := KT^.inx_pos;
  924.                   KT^.inx_pos := kt_inx[0];
  925.                   kt_read_index;
  926.                               KT^.inx_entry := 1;
  927.                   while y <> kt_inx[KT^.inx_entry] do
  928.                     Inc(KT^.inx_entry);
  929.             end
  930.           else begin z := kt_inx[KT^.inx_entry];
  931.                          if z > 0 then begin KT^.recptr := z;
  932.                                  NN_NN := kt_read_indexed(recpt);
  933.                                              exit;
  934.                                        end;
  935.              if z < 0 then begin
  936.                                        KT^.inx_pos := z;
  937.                        kt_read_index;
  938.                                        if kt_FORWARD > 0 then KT^.inx_entry := 0
  939.                                        else KT^.inx_entry := kt_inx_size[KT^.curtyp];
  940.                        end;
  941.                   end;
  942.         end;
  943. end;
  944.  
  945. function ktFind(fno : integer;var recpt; key : string) : integer;
  946.  
  947. var    x,y : integer; temk : pointer;
  948.  
  949. begin   ktFind := 0;
  950.         if not kt_FileOpen(fno) then exit;
  951.  
  952.     ktERRNO := 0;
  953.     KT^.BaseEntry := 0;
  954.     if kt_lookup(key) then
  955.         begin y := kt_read_indexed(recpt);
  956.               if y = 0 then exit;
  957.               GetMem(oldk,KT^.maxkey+1);
  958.               if oldk = nil then begin ktERRNO := 7;
  959.                            exit;
  960.                      end;
  961.               kt_setupkey(oldk^,recpt);
  962.               x := kt_keysmatch(key,oldk^);
  963.               FreeMem(oldk,KT^.maxkey+1);
  964.               if (x = 0)            or
  965.              ((kt_FORWARD > 0) and (x < 0))    or
  966.              ((kt_FORWARD < 0) and (x > 0))    then
  967.                          begin ktFind := y;
  968.                    exit;
  969.                          end;
  970.         end;
  971.     if kt_FORWARD = 0 then begin ktERRNO := 17;
  972.                          y := 0;
  973.                    end
  974.     else begin if kt_FORWARD > 0 then x := 26
  975.                    else                   x := 27;
  976.                    y := NN_NN(recpt,1,x);
  977.              end;
  978.     ktFind := y;
  979. end;
  980.  
  981. function   ktRead(f : integer; var data; key : string) : integer;
  982.  
  983. begin    kt_FORWARD := 0;
  984.     ktRead := ktFind(f,data,key);
  985. end;
  986.  
  987. function   ktReadAfter(f : integer; var data; key : string) : integer;
  988.  
  989. begin    kt_FORWARD := 1;
  990.     ktReadAfter := ktFind(f,data,key);
  991. end;
  992.  
  993. function   ktReadBefore(f : integer; var data; key : string) : integer;
  994.  
  995. begin    kt_FORWARD := -1;
  996.     ktReadBefore := ktFind(f,data,key);
  997. end;
  998.  
  999. function   ktLength(f : integer; key : string) : integer;
  1000.  
  1001. var    x : integer; temk : pointer;
  1002.  
  1003. begin    x := 0;
  1004.     if kt_FileOpen(f) then
  1005.         begin x := kt_exists(key);
  1006.               if x = 0 then ktERRNO := 17;
  1007.                 end;
  1008.     ktLength := x;
  1009. end;
  1010.  
  1011. function kt_goon(fno : integer;var recpt ; s : integer) : integer;
  1012.  
  1013. begin    kt_goon := 0;
  1014.      if not kt_FileOpen(fno) then exit;
  1015.      if s = 0 then KT^.recptr := 0;
  1016.      if KT^.recptr <= 0 then begin KT^.inx_pos := -KT^.keys^[3*KT^.curinx];
  1017.                        KT^.inx_entry := 0;
  1018.                  end
  1019.      else if KT^.del = 2 then Dec(KT^.inx_entry);
  1020.      kt_FORWARD := 1;
  1021.      KT^.BaseEntry := 0;
  1022.      kt_goon := NN_NN(recpt,1,26);
  1023. end;
  1024. function   ktNext(f : integer; var data) : integer;
  1025. begin       ktNext := kt_goon(f,data,1);
  1026. end;
  1027.  
  1028. function kt_goback(fno : integer; var recpt; s : integer) : integer;
  1029.  
  1030. begin   kt_goback := 0;
  1031.         if not kt_FileOpen(fno) then exit;
  1032.     if s = 0 then KT^.recptr := 0;
  1033.     if KT^.recptr <= 0 then begin
  1034.                                 KT^.inx_pos := -KT^.keys^[3*KT^.curinx];
  1035.                 KT^.inx_entry := kt_inx_size[KT^.curtyp];
  1036.                 end
  1037.     else if KT^.del = 1 then Inc(KT^.inx_entry);
  1038.     kt_FORWARD := 0;
  1039.     KT^.BaseEntry := 0;
  1040.     kt_goback := NN_NN(recpt,1,27);
  1041. end;
  1042. function   ktPrev(f : integer; var data) : integer;
  1043. begin    ktPrev := kt_goback(f,data,1);
  1044. end;
  1045. procedure del_undel(a : byte);
  1046. var    q,r,s,t : longint; r1 : array[0..11] of longint; b : byte;
  1047. begin    r := KT^.chain[0];
  1048.         s := r;
  1049.     q := KT^.chain[1];
  1050.         r1[1] := q;
  1051.         t := q;
  1052.     if a = 2 then begin t := KT^.recptr;
  1053.                             s := t;
  1054.                       end;
  1055.     b := KT^.status;
  1056.     kt_wrt_status;
  1057.     if KT^.dup <> 0 then
  1058.         begin if r = 0 then
  1059.                       begin KT^.status := a;
  1060.                 while r1[1] <> 0 do
  1061.                 begin kt_seek(r1[1]);
  1062.                   kt_wrt_data(KT^.status,1);
  1063.                   kt_read_data(r1[0],2*SizeOf(longint));
  1064.                             end;
  1065.                             KT^.status := b;
  1066.                       end
  1067.               else begin
  1068.                            kt_seek(r + 1 + SizeOf(longint));
  1069.                kt_wrt_data(t,SizeOf(longint));
  1070.                if q <> 0 then
  1071.                            begin Inc(q);
  1072.                                  kt_seek(q);
  1073.                                  kt_wrt_data(s,SizeOf(longint));
  1074.                            end;
  1075.                end;
  1076.         end;
  1077. end;
  1078. function ktDelete(f : integer; var data) : Boolean;
  1079. var     x,k : integer; temk : pointer;
  1080. begin     if kt_locked(f) then begin ktDelete := False;
  1081.                                          exit;
  1082.                                    end;
  1083.      KT^.status := KT^.status or $80;
  1084.      del_undel($82);
  1085.      if (KT^.status and 2) = 0 then
  1086.         begin k := KT^.curinx;
  1087.               if KT^.inxct > 1 then
  1088.               begin for x := 0 to KT^.inxct - 1 do
  1089.                     if x <> k then
  1090.                     begin kt_next_index(x);
  1091.                       kt_record_lookup(data);
  1092.                       kt_zero_index(x);
  1093.                 end;
  1094.                 kt_next_index(k);
  1095.               end;
  1096.               kt_record_lookup(data);
  1097.               kt_zero_index(k);
  1098.         end;
  1099.     ktDelete := True;
  1100. end;
  1101. function   ktUndelete(f : integer; var data) : Boolean;
  1102.  
  1103. begin   ktUndelete := False;
  1104.     if not kt_FileOpen(f) or  not kt_OKtowrite then exit;
  1105.     if KT^.recptr <= 0 then begin ktERRNO := 20;
  1106.                       exit;
  1107.                 end;
  1108.     if (KT^.status and $80) = 0 then begin ktERRNO := 29;
  1109.                                                exit;
  1110.                                          end;
  1111.     if (KT^.status and 2) = 0 then
  1112.         begin if not kt_OKtoadd(data,50) then exit;
  1113.               add_indexes(data);
  1114.                 end;
  1115.     KT^.status := KT^.status and $7f;
  1116.     del_undel(2);
  1117.     ktUndelete := True;
  1118. end;
  1119.  
  1120. procedure kt_alter_index(y : integer; var recpt);
  1121. begin      kt_next_index(y);
  1122.       KT^.inx_pos := oldix[y].ix;
  1123.       KT^.inx_entry := oldix[y].en;
  1124.       if KT^.inx_pos <> 0 then
  1125.         begin kt_read_index;
  1126.               if kt_alter[y].ix <> 0 then
  1127.               begin KT^.inx_entry := oldix[y].en;
  1128.                 kt_zero_index(y);
  1129.                 kt_update_index(recpt,1);
  1130.               end
  1131.               else if record_moved then
  1132.                begin kt_inx[KT^.inx_entry] := KT^.recptr;
  1133.                      kt_wrt_index;
  1134.                end;
  1135.         end;
  1136. end;
  1137. function   ktRewrite(f : integer; var data; size : integer) : Boolean;
  1138.  
  1139. var    x,y,z,i,j,k,e,ff : integer;    keypt,oldrec : pointer;
  1140.     areapt         : charp;    q,r,s,start : longint;
  1141.  
  1142. begin   ktRewrite := False;
  1143.     if size < 1 then begin ktERRNO := 15;
  1144.                    exit;
  1145.              end;
  1146.     if kt_locked(f) then exit;
  1147.     if (size < KT^.minsiz) and (KT^.status and 2 = 0) then
  1148.     begin GetMem(areapt,KT^.minsiz);
  1149.           FillChar(areapt^,KT^.minsiz,#0);
  1150.           Move(Chars(data),areapt^,size);
  1151.           if size < KT^.hks then size := KT^.hks;
  1152.           if areapt^[size-1] <> #0 then Inc(size);
  1153.     end
  1154.     else areapt := nil;
  1155.     q := KT^.recptr;
  1156.     r := KT^.inx_pos;
  1157.     e := KT^.inx_entry;
  1158.     k := KT^.curinx;
  1159.     start := q + KT^.dup + 1;
  1160.     kt_seek(start);
  1161.     kt_read_data(old_length,4);
  1162.     record_moved := (size > old_length[0] + old_length[1]);
  1163.  
  1164.     if (KT^.status and 2) = 0 then
  1165.         begin kt_inx_char := q;
  1166.               z := 1;
  1167.               if old_length[0] > KT^.maxkey then ff := old_length[0]
  1168.               else                 ff := KT^.maxkey+1;
  1169.               GetMem(oldrec,ff);
  1170.               FillChar(oldrec^,ff,#0);
  1171.               if oldrec = nil then
  1172.               begin ktERRNO := 7;
  1173.                 if areapt <> nil then FreeMem(areapt,KT^.minsiz);
  1174.                 exit;
  1175.               end;
  1176.               kt_read_data(oldrec^,old_length[0]);
  1177.               for y := KT^.inxct - 1 downto  0 do
  1178.               begin kt_next_index(y);
  1179.                 x := 0;
  1180.                             GetMem(keypt,KT^.maxkey+1);
  1181.                 if keypt = nil then
  1182.                 begin ktERRNO := 7;
  1183.                   FreeMem(oldrec,ff);
  1184.                   if areapt <> nil then
  1185.                                      FreeMem(areapt,KT^.minsiz);
  1186.                   exit;
  1187.                 end;
  1188.                             if areapt <> nil then
  1189.                      kt_setupkey(keypt^,areapt^)
  1190.                 else kt_setupkey(keypt^,Chars(data));
  1191.                 GetMem(oldk,KT^.maxkey+1);
  1192.                 if oldk = nil then
  1193.                 begin ktERRNO := 7;
  1194.                   FreeMem(keypt,KT^.maxkey+1);
  1195.                   FreeMem(oldrec,ff);
  1196.                   if areapt <> nil
  1197.                     then FreeMem(areapt,KT^.minsiz);
  1198.                   exit;
  1199.                 end;
  1200.  
  1201.                 kt_setupkey(oldk^,oldrec^);
  1202.                 kt_alter[y].ix := 0;
  1203.                 oldix[y].ix := 0;
  1204.                 if kt_keysmatch(oldk^,keypt^) <> 0 then
  1205.                 x := kt_exists(keypt^);
  1206.                 if (x = 0) and ((record_moved) or (kt_alter[y].ix <> 0)) then
  1207.                 begin
  1208.                   KT^.inx_pos := -KT^.keys^[3*KT^.curinx];
  1209.                   for j := 1 to KT^.maxkey do
  1210.                   begin kt_read_index;
  1211.                     i := kt_inx_key(Chars(oldk^)[j]);
  1212.                     if kt_inx[i] = 0 then
  1213.                             j := KT^.maxkey
  1214.                     else begin
  1215.                                              kt_inx_char := kt_inx[i];
  1216.                                              if kt_inx_char > 0 then
  1217.                          begin KT^.recptr := kt_inx_char;
  1218.                            j := KT^.maxkey
  1219.                          end
  1220.                          else KT^.inx_pos := kt_inx_char;
  1221.                          end;
  1222.                                   end;
  1223.                   oldix[KT^.curinx].ix := KT^.inx_pos;
  1224.                   oldix[KT^.curinx].en := i;
  1225.                 end;
  1226.                             FreeMem(oldk,KT^.maxkey+1);
  1227.                             FreeMem(keypt,KT^.maxkey+1);
  1228.                 if x <> 0 then begin ktERRNO := 30 + y;
  1229.                                  z := 0;
  1230.                                                  y := 0;
  1231.                        end;
  1232.               end;
  1233.               kt_next_index(k);
  1234.               FreeMem(oldrec,ff);
  1235.               KT^.recptr := q;
  1236.               KT^.inx_pos := r;
  1237.               KT^.inx_entry := e;
  1238.               if z = 0 then
  1239.               begin if areapt <> nil then FreeMem(areapt,KT^.minsiz);
  1240.                 exit;
  1241.               end;
  1242.         end;
  1243.     if record_moved then
  1244.         begin KT^.recptr := q;
  1245.               KT^.status := KT^.status or $80;
  1246.               kt_wrt_status;
  1247.               KT^.recptr := KT^.fsize;
  1248.                       s := KT^.recptr;
  1249.               KT^.status := KT^.status and $7f;
  1250.                       if areapt <> nil then
  1251.                     kt_wrt_elem(areapt^,size)
  1252.               else  kt_wrt_elem(Chars(data),size);
  1253.               if KT^.dup <> 0 then
  1254.               begin if KT^.chain[0] <> 0 then
  1255.                 begin kt_seek(KT^.chain[0] + 1 + SizeOf(longint));
  1256.                   kt_wrt_data(s,SizeOf(longint));
  1257.                             end;
  1258.                 if KT^.chain[1] <> 0 then
  1259.                 begin kt_seek(KT^.chain[1] + 1);
  1260.                   kt_wrt_data(s,SizeOf(longint));
  1261.                             end;
  1262.                       end;
  1263.         end
  1264.     else    begin if size <> old_length[0] then
  1265.               begin Inc(old_length[1],old_length[0] - size);
  1266.                 old_length[0] := size;
  1267.                 kt_seek(start);
  1268.                 kt_wrt_data(old_length,4);
  1269.                       end
  1270.               else kt_seek(start + 4);
  1271.                       if areapt <> nil then
  1272.                     kt_wrt_data(areapt^,size)
  1273.               else  kt_wrt_data(Chars(data),size);
  1274.         end;
  1275.     if (KT^.status and 2) = 0 then
  1276.                       if areapt <> nil then
  1277.                       begin for y := 0 to KT^.inxct- 1 do
  1278.                 if y <> k then kt_alter_index(y,areapt^);
  1279.                     kt_alter_index(k,areapt^);
  1280.                       end
  1281.                       else
  1282.                       begin for y := 0 to KT^.inxct- 1 do
  1283.                 if y <> k then kt_alter_index(y,Chars(data));
  1284.                 kt_alter_index(k,Chars(data));
  1285.               end;
  1286.     if areapt <> nil then FreeMem(areapt,KT^.minsiz);
  1287.     ktRewrite := True;
  1288. end;
  1289.  
  1290. procedure ktGetChar;
  1291.  
  1292. var    d : integer; Regs : registers;
  1293.  
  1294. begin    if (ktRUNCH <> char(0)) or (ktRUNSC <> 0) then
  1295.             begin ktCHAR := ktRUNCH;
  1296.                       ktSCAN := ktRUNSC;
  1297.                       ktRUNCH := char(0);
  1298.                       ktRUNSC := 0;
  1299.                 end
  1300.     else while True do
  1301.         begin Regs.ax := 0;
  1302.               intr($16,Regs);
  1303.               ktSCAN := integer(regs.ah);
  1304.               ktCHAR := char(regs.al);
  1305.               if (ktSCAN < 59) or (ktSCAN > 68) or (kt_function)
  1306.                          then exit;
  1307.                       ktFKEY := ktSCAN - 58;
  1308.               kt_function := True;
  1309.                       ktProcessFunctionKey;
  1310.               kt_function := False;
  1311.                 end;
  1312. end;
  1313. procedure ktGetPress;
  1314. begin    ktGetChar;
  1315.         ktRUNCH := ktCHAR;
  1316.     ktRUNSC := ktSCAN;
  1317. end;
  1318. function   ktGetStr(var data ; maxlen : integer) : integer;
  1319. var    x,z : integer;
  1320. begin    if maxlen = 0 then maxlen := -1;
  1321.         x := 1;
  1322.         z := 0;
  1323.     while (z = 0) do
  1324.     begin ktGetChar;
  1325.           if (ktSCAN = 1) or (ktSCAN = 28) then z := 1
  1326.               else begin if (ktSCAN = 14) then
  1327.                  begin if x > 1 then begin Dec(x);
  1328.                                                    Chars(data)[x] := #0;
  1329.                                                    ktBackSpace;
  1330.                                              end;
  1331.                          end
  1332.              else begin if (ktCHAR = #0) then
  1333.                     begin if (ktSCAN = 75) and (x > 0) then
  1334.                       begin ktPutChar(#8);
  1335.                         Dec(x);
  1336.                       end else if (ktSCAN = 77) and
  1337.                                                       (x < maxlen) then
  1338.                       begin if Chars(data)[x] < #32 then
  1339.                             Chars(data)[x] := ' ';
  1340.                         ktPutChar(Chars(data)[x]);
  1341.                         Inc(x);
  1342.                       end;
  1343.                     end
  1344.                     else begin if x >= maxlen then z := 1
  1345.                            else if ktCHAR > #31 then
  1346.                             begin Chars(data)[x] := ktCHAR;
  1347.                               Inc(x);
  1348.                               ktPutChar(ktCHAR);
  1349.                             end;
  1350.                      end;
  1351.                   end;
  1352.            end;
  1353.     end;
  1354.     ktGetStr := x;
  1355.         Dec(x);
  1356.         Chars(data)[0] := char(x);
  1357. end;
  1358. function get_next_part(k : integer; var recpt, keypt) : integer;
  1359. var     x,y,z,L : integer; q : longint;
  1360.  
  1361. begin    L := KT^.keys^[KT^.ixdes + 2*k];
  1362.     y := 1;
  1363.     for x := ktCT to ktCT + L - 1 do Chars(keypt)[x] := #0;
  1364.         get_next_part := 0;
  1365.     for x := 1 to L do
  1366.         begin ktGetChar;
  1367.               if (ktSCAN = 14) or
  1368.                          ((ktCHAR = #0) and (ktSCAN = 75)) then
  1369.                       begin if ktCT > 1 then
  1370.                             begin Dec(ktCT);
  1371.                   Chars(keypt)[ktCT] := #0;
  1372.                                   Dec(Chars(keypt)[0]);
  1373.                                   ktBackSpace;
  1374.                       if ktCT = 1 then
  1375.                                      KT^.inx_pos := -KT^.keys^[3*KT^.curinx]
  1376.                   else begin KT^.inx_pos := q;
  1377.                          kt_read_index;
  1378.                          q := kt_inx[0];
  1379.                        end;
  1380.                             end;
  1381.                       end
  1382.               else  begin if ktSCAN = 1 then exit;
  1383.                       if ktSCAN = 28 then ktCHAR := #0
  1384.                       else if ktCHAR > #31 then ktPutChar(ktCHAR);
  1385.                       Chars(keypt)[ktCT] := ktCHAR;
  1386.                                   Inc(Chars(keypt)[0]);
  1387.                           Inc(ktCT);
  1388.                       kt_read_index;
  1389.                       z := kt_inx_key(ktCHAR);
  1390.                                   kt_inx_char := kt_inx[z];
  1391.                       if kt_inx_char > 0 then
  1392.                   begin KT^.recptr := kt_inx_char;
  1393.                     get_next_part :=
  1394.                          kt_read_indexed(recpt);
  1395.                     kt_found := True;
  1396.                     exit;
  1397.                   end;
  1398.                       if kt_inx_char = 0 then
  1399.                                   begin if ktCHAR = #0 then get_next_part := -1;
  1400.                                         exit;
  1401.                                   end;
  1402.                       q := KT^.inx_pos;
  1403.                       KT^.inx_pos := kt_inx_char;
  1404.                       if ktCHAR = #0 then begin get_next_part := 1;
  1405.                                                        exit;
  1406.                                                  end;
  1407.                       end;
  1408.         end;
  1409.     get_next_part := y;
  1410. end;
  1411. function   ktGetKey(f : integer; var data,key) : integer;
  1412.  
  1413. var    y,k : integer;
  1414.  
  1415. begin    if not kt_FileOpen(f) then y := 0
  1416.     else  begin
  1417.           KT^.inx_pos := -KT^.keys^[3*KT^.curinx];
  1418.           KT^.del := 0;
  1419.           KT^.BaseEntry := 0;
  1420.           KT^.recptr := 0;
  1421.           Chars(key)[0] := #0;
  1422.           ktCT := 1;
  1423.           for k := 0 to KT^.keys^[3*KT^.curinx + 2] - 1 do
  1424.           begin kt_found := False;
  1425.             y := get_next_part(k,data,key);
  1426.             if (kt_found) or (y <= 0) then
  1427.                     begin ktGetKey := y;
  1428.                           if ktCHAR = #0 then Dec(Chars(key)[0]);
  1429.                           exit;
  1430.                     end;
  1431.                 ktSeparator;
  1432.               end;
  1433.               end;
  1434.     ktGetKey := y;
  1435. end;
  1436. function   ktReadAll(f : integer; var data; key : string) : integer;
  1437. var    x,y,z,ff : integer; okey : pointer;
  1438. begin   ktReadAll := 0;
  1439.     if not kt_FileOpen(f) then exit;
  1440.     KT^.inx_pos := -KT^.keys^[3*KT^.curinx];
  1441.     KT^.BaseEntry := 1;
  1442.     KT^.base := -1;
  1443.     y := integer(key[0]);
  1444.     if y > KT^.maxkey then y := KT^.maxkey;
  1445.     for x := 1 to y do
  1446.     begin KT^.base := KT^.inx_pos;
  1447.           kt_read_index;
  1448.           z := kt_inx_key(key[x]);
  1449.           if kt_inx[z] = 0 then begin KT^.BaseEntry := 0;
  1450.                       ktERRNO := 17;
  1451.                       exit;
  1452.                     end;
  1453.           KT^.inx_entry := z;
  1454.           KT^.BaseEntry := KT^.inx_entry;
  1455.               kt_inx_char := kt_inx[z];
  1456.               if kt_inx_char  > 0 then
  1457.           begin KT^.recptr := kt_inx_char;
  1458.             z := kt_read_indexed(data);
  1459.             if z <> 0 then
  1460.             begin ff := KT^.maxkey+1;
  1461.               GetMem(okey,ff);
  1462.               if (okey = nil) then exit;
  1463.               kt_setupkey(okey^,data);
  1464.               while (x <= y) do
  1465.               begin if kt_inx_key(key[x]) <>
  1466.                    kt_inx_key(Chars(okey^)[x]) then
  1467.                 begin KT^.BaseEntry := 0;
  1468.                       z := 0;
  1469.                       ktERRNO := 17;
  1470.                       x := y + 1;
  1471.                 end
  1472.                                 else  Inc(x);
  1473.               end;
  1474.               FreeMem(okey,ff);
  1475.               ktReadAll := z;
  1476.                           exit;
  1477.                     end;
  1478.               end;
  1479.           KT^.inx_pos := kt_inx_char;
  1480.         end;
  1481.     KT^.inx_entry := 0;
  1482.     kt_FORWARD := 1;
  1483.     ktReadAll := NN_NN(data,0,0);
  1484. end;
  1485. function ktFileBase(var recpt; fno : integer) : integer;
  1486. begin    if kt_FileOpen(fno) then
  1487.     begin if (KT^.BaseEntry <> 0) and (KT^.base < 0) then
  1488.           begin if (KT^.del <> 0) and ((KT^.base > KT^.inx_pos) or
  1489.                        (KT^.inx_entry = KT^.BaseEntry))
  1490.             then begin if kt_FORWARD <> 0 then
  1491.                    begin if KT^.del = 2 then Dec(KT^.inx_entry);
  1492.                    end
  1493.                    else
  1494.                    begin if KT^.del = 1 then Inc(KT^.inx_entry);
  1495.                    end;
  1496.              end;
  1497.             ktFileBase := NN_NN(recpt,0,0);
  1498.                     exit;
  1499.               end
  1500.               else begin if KT^.BaseEntry <> 0 then ktERRNO := 0
  1501.                          else ktERRNO := 25;
  1502.                    end;
  1503.         end;
  1504.     ktFileBase := 0;
  1505. end;
  1506. function   ktNextAll(f : integer; var data) : integer;
  1507. begin    kt_FORWARD := 1;
  1508.     ktNextAll := ktFileBase(data,f);
  1509. end;
  1510. function   ktPrevAll(f : integer; var data) : integer;
  1511. begin    kt_FORWARD := 0;
  1512.     ktPrevAll := ktFileBase(data,f);
  1513. end;
  1514. function ktAddChain(f : integer; var data; size : integer) : Boolean;
  1515. var    q,r : longint;
  1516. begin   ktAddChain := False;
  1517.     if kt_FileReady(f) then
  1518.     begin if KT^.dup = 0 then ktERRNO := 23
  1519.           else if kt_OKtowrite then
  1520.     begin if size < 1 then ktERRNO := 15
  1521.           else begin q := KT^.fsize;
  1522.              kt_seek(KT^.recptr + 1 + SizeOf(longint));
  1523.              kt_wrt_data(q,SizeOf(longint));
  1524.              r := KT^.chain[1];
  1525.              if r <> 0 then begin Inc(r);
  1526.                           kt_seek(r);
  1527.                           kt_wrt_data(q,SizeOf(longint));
  1528.                     end;
  1529.              KT^.chain[0] := KT^.recptr;
  1530.              KT^.recptr := q;
  1531.              KT^.status := 2;
  1532.              kt_wrt_elem(data,size);
  1533.              ktAddChain := True;
  1534.            end;
  1535.     end;
  1536.     end;
  1537. end;
  1538. function NN_Chain(var recpt; fno, n : integer) : integer;
  1539. var    q : longint; x : integer;
  1540. begin
  1541.     NN_Chain := 0;
  1542.     if kt_FileOpen(fno) then
  1543.     begin if KT^.dup = 0 then                  ktERRNO := 23 else
  1544.           begin if KT^.recptr <= 0 then         ktERRNO := 20 else
  1545.             begin x := KT^.status and $80;
  1546.               if (x <> 0) and (KT^.chain[0] = 0) then
  1547.                 ktERRNO := 28 else
  1548.               begin q := KT^.chain[n];
  1549.                 if q <> 0 then
  1550.                 begin KT^.recptr := q;
  1551.                       kt_seek(q);
  1552.                       kt_read_data(KT^.status,1);
  1553.                       NN_Chain := kt_read_elem(recpt);
  1554.                 end;
  1555.               end;
  1556.             end;
  1557.           end;
  1558.     end;
  1559. end;
  1560. function   ktNextChain(f : integer; var data) : integer;
  1561. begin    ktNextChain := NN_Chain(data,f,1);
  1562. end;
  1563. function   ktPrevChain(f : integer; var data) : integer;
  1564. begin    ktPrevChain := NN_Chain(data,f,0);
  1565. end;
  1566. function   ktStart(f : integer; var data) : integer;
  1567. begin    ktStart := kt_goon(f,data,0);
  1568. end;
  1569. function   ktEnd(f : integer; var data) : integer;
  1570. begin    ktEnd := kt_goback(f,data,0);
  1571. end;
  1572. function record_status : Boolean;
  1573. begin    kt_seek(KT^.recptr);
  1574.     kt_read_data(KT^.status,1);
  1575.     ktINDEXED := ( (KT^.status and 2) = 0);
  1576.     record_status := ((KT^.status < byte('0')) or (KT^.status > byte('9')));
  1577. end;
  1578. function kt_goonPhys(fno : integer; var recpt;s : integer) : integer;
  1579. var    y : integer; b : byte;
  1580. begin   kt_goonPhys := 0;
  1581.         if not kt_FileOpen(fno) then exit;
  1582.     if s = 0 then KT^.recptr := 0;
  1583.         if KT^.recptr <= 0 then KT^.recptr := KT^.start
  1584.                            else KT^.recptr := KT^.nexrec;
  1585.     while True do
  1586.     begin if KT^.recptr >= KT^.fsize then
  1587.           begin ktERRNO := 19;
  1588.                     exit;
  1589.               end;
  1590.           if record_status then
  1591.           begin y := kt_read_elem(recpt);
  1592.                     if (KT^.status and $80) <> 0 then y := -y;
  1593.                 kt_goonPhys := y;
  1594.                     exit;
  1595.               end;
  1596.               b := KT^.status - 48;
  1597.               Inc(KT^.recptr, 3 + kt_inx_size[KT^.keys^[3*b + 1]]*SizeOf(longint));
  1598.     end;
  1599. end;
  1600. function   ktNextPhys(f : integer; var data) : integer;
  1601. begin    ktNextPhys := kt_goonPhys(f,data,1);
  1602. end;
  1603. function kt_gobackPhys(var recpt; fno, s : integer) : integer;
  1604. var    z : integer;
  1605. begin   kt_gobackPhys := 0;
  1606.     if not kt_FileOpen(fno) then exit;
  1607.     if s = 0 then KT^.recptr := 0;
  1608.     if KT^.recptr <= 0 then    KT^.recptr := KT^.fsize;
  1609.     while True do
  1610.     begin if KT^.recptr <= KT^.start then begin ktERRNO := 21;
  1611.                                                     exit;
  1612.                                               end;
  1613.           kt_seek(KT^.recptr - 2);
  1614.               kt_read_data(z,2);
  1615.               Dec(KT^.recptr,z);
  1616.               if record_status then
  1617.           begin z := kt_read_elem(recpt);
  1618.                     if (KT^.status and $80) <> 0 then z := -z;
  1619.                     kt_gobackPhys := z;
  1620.                     exit;
  1621.           end;
  1622.     end;
  1623. end;
  1624. function   ktPrevPhys(f : integer; var data) : integer;
  1625. begin    ktPrevPhys := kt_gobackPhys(data,f,1);
  1626. end;
  1627. function   ktStartPhys(f : integer; var data) : integer;
  1628. begin    ktStartPhys := kt_goonPhys(f,data,0);
  1629. end;
  1630. function   ktEndPhys(f : integer; var data) : integer;
  1631. begin    ktEndPhys := kt_gobackPhys(data,f,0);
  1632. end;
  1633. function FirstChar(y, f : integer) : Boolean;
  1634. begin    FirstChar := False;
  1635.     if not kt_FileReady(f) then exit;
  1636.     if (KT^.status and $80) <> 0 then begin ktERRNO := 28;
  1637.                                                 exit;
  1638.                                           end;
  1639.     KT^.status := (KT^.status and 254) or y;
  1640.     kt_wrt_status;
  1641.     FirstChar := ktFlush(f);
  1642. end;
  1643. function ktLock(f : integer) : Boolean;
  1644. begin    ktLock := FirstChar(1,f);
  1645. end;
  1646. function ktUnlock(f : integer) : Boolean;
  1647. begin    ktUnlock := FirstChar(0,f);
  1648. end;
  1649. function   ktLocked(f : integer; key : string) : Boolean;
  1650.  
  1651. begin   ktLocked := False;
  1652.     if not kt_FileOpen(f) then exit;
  1653.     if kt_exists(key) = 0 then begin ktERRNO := 17;
  1654.                        ktLocked := False;
  1655.                  end
  1656.     else ktLocked := ((KT^.status and 1) <> 0);
  1657. end;
  1658. function   ktSize(f : integer) : longint;
  1659. begin    if not kt_FileOpen(f) then ktSize := 0
  1660.     else  ktSize := KT^.fsize;
  1661. end;
  1662. function   ktRecords(f,typ : integer) : longint;
  1663. var       x,l : longint; b,c : byte; a : array[0..7] of char;
  1664. begin
  1665.        if not kt_FileOpen(f) then begin ktRecords := 0;
  1666.                         exit;
  1667.                       end;
  1668.        l := KT^.start;
  1669.            x := 0;
  1670.        while (l < KT^.fsize) do
  1671.        begin kt_seek(l);
  1672.          kt_read_data(a,1);
  1673.          if (a[0] >= '0') and (a[0] <= '9') then
  1674.          Inc(l, kt_inx_size[KT^.keys^[3*(byte(a[0])-48) + 1]]*SizeOf(longint)
  1675.               + 3)
  1676.          else begin b := byte(a[0]) and $80;
  1677.                 if (typ = 0) or
  1678.                                ((typ > 0) and (b = 0)) or
  1679.                                ((typ < 0) and (b <> 0)) then Inc(x);
  1680.                 if KT^.dup <> 0 then kt_read_data(a,KT^.dup);
  1681.                 kt_read_data(kt_tmplen[0],2);
  1682.                 kt_read_data(kt_tmplen[1],2);
  1683.                 Inc(l, 7 + KT^.dup + kt_tmplen[0] + kt_tmplen[1]);
  1684.               end;
  1685.            end;
  1686.        ktRecords := x;
  1687. end;
  1688. function ktMaxRead(f,max : integer) : integer;
  1689. begin      ktMaxRead := 0;
  1690.        if kt_FileOpen(f) then
  1691.        begin if (max < 0) or ((max > 0) and (max < KT^.minsiz)) then
  1692.          ktERRNO := 15
  1693.          else begin KT^.maxread := max;
  1694.                 ktMaxRead := KT^.minsiz;
  1695.               end;
  1696.        end;
  1697. end;
  1698. procedure KtBuildKey(f : integer; var d ;f1,f2 : string);
  1699. var x,y,m1,m2 : integer;
  1700. type chars = array[0..1] of char;
  1701. begin   if not kt_FileOpen(f) then exit;
  1702.     y := 3*KT^.inxct;
  1703.     for x := 0 to KT^.curinx - 1 do Inc(y,2*KT^.keys^[3*x + 2]);
  1704.     m1 := KT^.keys^[y];
  1705.     m2 := KT^.keys^[y + 2];
  1706.         x := m1 + m2;
  1707.     FillChar(d,x + 1, #0);
  1708.     x := length(f1);
  1709.     if x > m1 then x := m1;
  1710.     Move(f1[1],chars(d)[1],x);
  1711.     if x < m1 then Inc(x);
  1712.     y := length(f2);
  1713.     if y > m2 then y := m2;
  1714.     Move(f2[1],chars(d)[1 + x],y);
  1715.     if y < m2 then Inc(y);
  1716.     chars(d)[0] := char(x + y);
  1717. end;
  1718. {$I+}
  1719. end.
  1720.